home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / nrpas13.arc / SORT2.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-01  |  1KB  |  46 lines
  1. PROCEDURE sort2(n: integer;VAR ra,rb: glsarray);
  2. (* Programs using routine SORT2 must define type
  3. TYPE
  4.    glsarray = ARRAY [1..np] OF real;
  5. in the main routine, with np >= n.   *)
  6. LABEL 99;
  7. VAR
  8.    l,j,ir,i: integer;
  9.    rrb,rra: real;
  10. BEGIN
  11.    l := (n DIV 2)+1;
  12.    ir := n;
  13.    WHILE true DO BEGIN
  14.       IF (l > 1) THEN BEGIN
  15.          l := l-1;
  16.          rra := ra[l];
  17.          rrb := rb[l]
  18.       END ELSE BEGIN
  19.          rra := ra[ir];
  20.          rrb := rb[ir];
  21.          ra[ir] := ra[1];
  22.          rb[ir] := rb[1];
  23.          ir := ir-1;
  24.          IF (ir = 1) THEN BEGIN
  25.             ra[1] := rra;
  26.             rb[1] := rrb;
  27.             GOTO 99
  28.          END
  29.       END;
  30.       i := l;
  31.       j := l+l;
  32.       WHILE (j <= ir) DO BEGIN
  33.          IF (j < ir) THEN
  34.             IF (ra[j] < ra[j+1]) THEN j := j+1;
  35.          IF (rra < ra[j]) THEN BEGIN
  36.             ra[i] := ra[j];
  37.             rb[i] := rb[j];
  38.             i := j;
  39.             j := j+j
  40.          END ELSE j := ir+1
  41.       END;
  42.       ra[i] := rra;
  43.       rb[i] := rrb
  44.    END;
  45. 99:   END;
  46.